home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / Clone / memrefs.f < prev    next >
Encoding:
FORTH Source  |  1989-02-08  |  2.6 KB  |  131 lines
  1.  
  2. only forth definitions
  3.  
  4.  
  5. anew task-memrefs.f
  6.  
  7.  
  8. \ Words to handle the actual target area building........................
  9.  
  10. variable MaxImageSize   \   64 1024 * MaxImageSize !
  11.  
  12.  
  13. also TGT definitions
  14.  
  15. 0 DynamicStack TargetImage
  16.  
  17. also forth definitions
  18.  
  19. : InitClone
  20.   TargetImageVAR FreeStack
  21.   InitClone
  22. ;
  23.  
  24. previous definitions
  25.  
  26.  
  27. : TargetHERE   ( -- addr )    TargetImageBase FreeByte      ;
  28.  
  29.  
  30. EXISTS? Status? .IF
  31.   ' TargetHERE is TargetSize
  32. .THEN
  33.  
  34.  
  35. : TargetHas?   ( addr -- addr )
  36.   \ dup MaxImageSize @ U> ?ABORT" Increase 'MaxImageSize'...limit reached."
  37.   TargetImage over cell+ enlarge?
  38. ;
  39.  
  40. : TargetAllot  ( #bytes -- )
  41.   TargetHERE +    ( -- newused )  TargetHas?
  42.   TargetImageBase freebytea !  ;
  43.  
  44. : Target@  ( adr -- data )   TargetImageBase + @    ;
  45. : TargetW@ ( adr -- data )   TargetImageBase + w@   ;
  46. : Targetc@ ( adr -- data )   TargetImageBase + c@   ;
  47.  
  48. : Target!  ( data adr -- )   TargetHas?  TargetImageBase + !    ;
  49. : TargetW! ( data adr -- )   TargetHas?  TargetImageBase + W!   ;
  50. : TargetC! ( data adr -- )   TargetHas?  TargetImageBase + C!   ;
  51.  
  52. : Target,  ( n1 -- )   TargetHERE    4 TargetAllot  Target!   ;
  53. : TargetW, ( n1 -- )   TargetHERE    2 TargetAllot  TargetW!  ;
  54. : TargetC, ( n1 -- )   TargetHERE    1 TargetAllot  TargetC!  ;
  55.  
  56.  
  57. : TargetMove  ( from to cnt -- )
  58.   2dup +       TargetHas? drop
  59.   dup 3 pick + TargetHas? drop
  60.   >r  2 0
  61.   DO  TargetImageBase + swap
  62.   LOOP
  63.   r> move
  64. ;
  65.  
  66.  
  67. : TargetFill  ( addr cnt byte -- )
  68.   >r  2dup + TargetHas? drop  >r
  69.   TargetImageBase +
  70.   r> r> fill
  71. ;
  72.  
  73.  
  74. : TargetErase ( adr cnt -- )
  75.   0 TargetFill
  76. ;
  77.  
  78. also Forth Definitions
  79.  
  80. : +t  ( offset -- address )
  81.   targetimagebase +
  82. ;
  83.  
  84. .need RelDism
  85. : RelDism  2drop ;
  86. >newline
  87. cr ." NOTE: disassembler not available; SHOWME will not display code."
  88. cr cr
  89. .then
  90.  
  91. previous definitions
  92.  
  93. : showcfa  ( cfa -- )  Substitute?  base @ >r  hex
  94.   >newline  dup >name id. space   dup
  95.   References stackfind 0=  swap drop
  96.   IF
  97.      ." is not compiled within the current TargetImage."
  98.   ELSE
  99.      dup cell- @ $ f,0000 and  dup VARIABLE_ID = swap USER_ID = or
  100.      IF
  101.         ." is Target Compiled as a VARIABLE at $ "  false
  102.      ELSE
  103.         ." is code residing at target address $ "   true
  104.      THEN
  105.      ( -- cfa flag )
  106.      over PacketFor ..@ ref_TgtAdr dup . swap   ( -- cfa tgtadr flag )
  107.      IF
  108.         0 +t  over +t  RelDism
  109.       \ dup +t cr dism
  110.      THEN
  111.      drop
  112.   THEN
  113.   drop  r> base !  cr
  114. ;
  115.  
  116. also Forth Definitions
  117.  
  118. : Showme  ( -- , name )
  119.   [compile] '  showcfa
  120. ;
  121.  
  122.  
  123. : >TargetAdr  ( cfa -- target-relative-adr )
  124.   dup References stackfind  swap drop  0=
  125.   ?ABORT" Specified resident CFA (on stack) does not exist in Target!"
  126.   PacketFor ..@ ref_TgtAdr
  127. ;
  128.  
  129. only forth definitions
  130. also TGT
  131.